logo

Introducción.

A partir de los primeros meses de 2020, México ha visto el impacto generado por la pandemia mundial de SARS-COV2. El primer caso confirmado, en México, se registró el 28 de febrero de 2020. Pocos días después el Gobierno Mexicano declaró la llamada Jornada Nacional de Sana Distancia, en la cuál invitaban a la población a permanecer en casa con el fin de evitar una rápida propagación del virus.

Esta medida, como era de esperarse, tuvo gran impacto en la normalidad de la sociedad implicando problemas socio-económicos, por mencionar algunos: pérdida de enpleo por parte de algunos sectores de la población o dificultad para ejercerlo, disminución en el salario, imortante disminución en el consumo de servicios, etc.

Dado lo anterior resultá interesante preguntarse: ¿Cómo se ha visto afectados algunos indicadores socieconomicos a lo largo de este periodo de tiempo?. El presente trabajo busca estudiarlos y analizarlos, mediante el uso de técnicas de series de tiempo, así como pronosticar el comportamiento de estos.

La movilidad se vio limitada, los medios de transporte vieron una reducción en uso significativa, comportamiento que se esperaba ser al contrario cn los tranportes particulares, ya que podían ser una forma más segura de trasladarse de un lugar a otro.

Tras el brote de la COVID-19, cada vez más personas trabajan, estudian y socializan desde sus casas. A lo largo de la cadena de valor de Internet, los operadores de comunicaciones, los proveedores de contenido y servicios en la nube, así como también los puntos de intercambio de Internet (IXP), han experimentado hasta un 60% más de tráfico de Internet en comparación con el tráfico previo al brote. En esta situación sin precedentes, la resiliencia y la capacidad de las redes de banda ancha se han vuelto aún más esenciales. (consulte mas aqui)

Por otra parte, el dólar es conosiderado un referente en la economía mundial particularmente para las economías Latinoamericanas, cuyas monedas se han visto depreciadas a lo largo de todo este periodo, afectando para bien o para mal otras industrias, repercutiendo tanto en la inflación como en la deuda publica.

" El desarrollo de la pandemia y la expectativa de recuperación económica global son los principales factores fundamentales que determinan el tipo de cambio", esta es otra variable de estudio en este docuemnto.

Información sobre los Datos.

Se buscaron diversas fuentes de información de las cuales obtener las series de tiempo:

  • Los indicadores de movilidad se extrajeron de el Portal de Datos Abiertos, en el cual se encontraban series de tiempo de las afluencias en diversos medios de tránsporte en CDMX, registradas desde finales de marzo de 2020 hasta finales de enero de 2021.

Los datos de esta serie son diferencias porcentuales diarias respecto a lo definido como un día típico. La definición de este día típico se baso en un histórico desde 2018 para calcular la afuencia promedio para cada día de la semana ajustados con la afluencia registrada durante la primera quincena de marzo de 2020. Más información

  • Los indicadores de movilidad de los vehículos particulares (obtenidos aquí), se calculan de una manera similar a los indices de movilidad en el transporte, con la diferencia de que la alfuencia en un día típico se calculó respecto a un histórico desde la segunga semana de enero y febrero de 2020 Más información

  • El trafico diario de internet se extrajo del portal abierto de la comision de regulacion de comunicaciones. Varios de los proveedores de servicios digitales son reconocidos y usados a lo largo de todo el continente americano. (consulte mas aqui)

La información de trafico diario reportado por los Proveedores de Servicio de Internet, fue recopilada desde el 30 de marzo del 2020 hasta el 26 de enero del 2021. (Obtenidos aqui)

La base de datos proporcionada, nos brinda la cantidad de datos (en GB) que circulan a traves de distintos proveedores de servicios digitales por medio de su infraestructura de red. Este dataset contempla distintos provedores que presentan comportamientos identicos a lo largo e la pandemia, por lo cual podrian ser omitidos para evitar estudiar informacion muy parecida en las series.

  • El data set a analizar (de las cambios del precio del dólar) contempla la fluctuación del tipo de cambio a partir del viernes 20 de marzo cuando se decreto la cuarentena y las medidas de quedarse en casa, y de solo contemplar actividades escenciales se llevaron a cabo y concluye el ultimo día del año 2020.

La apertura y el cierre por día son indicadores que da la bolsa de valores para poder observar la diferencia entre estos de acuerdo a las especulaciones del mercado.

Consideraciones.

Dado que se va a estudiar sobre series de tiempo, es importante tener en cuenta que el ajuste de modelos debe generar, en los residuales, ruido blanco cuyas características son el hecho de tener media cero, varianza constante y que estos no esten altamente correlacionados.

Considerando esto en la mayoría de los modelos se ultilizara para métrica la Prueba de hípotesis de Box-Ljung, cuyas hipótesis son:

\(H_0\): Ruido blanco en residuales vs \(H_1\): Ausencia de ruido blanco en residuales

Esto para poder tener una métrica de la fiabilidad de los respectivos modelos y, por ende, de los pronósticos que éstos generen.

Movilidad en CDMX (Tránsporte público).

Análisis exploratorio.

La base de datos cuenta con las diferencias porcentuales del metro, metrobús, trolebús, rtp y ecobici, los cuales son los medios de trásporte mas recurrentes en la Ciudad, estos pueden presentar correlación entre ellos, por lo cual prodríamos omitir alguno para evitar estudiar información muy parecida en las series.

Consideraremos una alta correlación aquellos por encima de 0.8 en coeficiente de correlación.

hospitalizados_transporte_movilidad <- read.csv('/cloud/project/hospitalizados-transporte-movilidad.csv')
movilidad <- hospitalizados_transporte_movilidad[, c('fecha', 'metro', 
                                                     'metrobus',
                                                     'trolebus',
                                                     'rtp', 
                                                     'ecobici')]
movilidad <- mutate(movilidad, fecha = as.Date(fecha, '%d/%m/%Y'))
corr <- cor(movilidad[,-c(1)])
corr
               metro  metrobus  trolebus       rtp   ecobici
  metro    1.0000000 0.6927117 0.6375448 0.8128577 0.6682762
  metrobus 0.6927117 1.0000000 0.9031026 0.6334265 0.7931347
  trolebus 0.6375448 0.9031026 1.0000000 0.7225076 0.5820793
  rtp      0.8128577 0.6334265 0.7225076 1.0000000 0.5427892
  ecobici  0.6682762 0.7931347 0.5820793 0.5427892 1.0000000

Dado esto, omitimos la información tanto de rtp como de trolebús. Y vemos ahora, de manera gráfica la correlación entre las variables resultantes, notamos que hay correlaciones hasta de 0.79 entre ecobici y metrobús, pero consevaremos estas variables ya que el ecobici es una forma más rápida de transporte y la mayor preferencia de algunas personas. Enfocado al estudio de sus afluencias, es interesante también estudiar este comportamiento.

movilidad <- movilidad[ , -4] 
movilidad <- movilidad[ , -4]
corr <- cor(movilidad[,-c(1)])
ggcorrplot(corr, method = "circle", 
           hc.order = TRUE,
           lab = TRUE,
           outline.color = "white",
           ggtheme = ggplot2::theme_gray,
           colors = c("#6D9EC1", "white", "#E46726")) +
  ggtitle("Correlograma de los medios de transporte CDMX") +
  theme_minimal()

A continuación se presentan histogramas y densidades obtenidas de los datos, notamos que para el metro, los descensos más frecuentes rondan en tre el 40% y 50%, también hay una segunda moda alrededor de 70%, estos resgitros sucedieron al inicio de la restricción social.

El metrobus presenta descensos, en frecuencia relativamente más variables a lo largo del tiempo, siendo las más frecuentes entre 70% y 50%.

Los descensos de afluencia en el uso de ecobici, tienen una mayor frecuencia entre 60% y 70%, siento este rango el más frecuente desde finales de marzo de 2020.

En general, logramos apreciar un descenso importante en la afluencia de estos medios de transporte, lo cuál ers de esperarse.

par(mfrow=c(2, 2))
## Histograma y densidad del metro.
with(movilidad, hist(metro, freq = FALSE,breaks="Sturges", col="lightblue", title='Histograma de 
       dendsidad de la afluencia en el metro de CDMX'))
lines(density(movilidad$metro), col="blue")

## Histograma y densidad del metrobus.
with(movilidad, hist(metrobus, freq = FALSE, breaks="Sturges", col="orange",title='Histograma de 
      dendsidad de la afluencia en el metrobús de CDMX'))
lines(density(movilidad$metrobus), col="red")

## Histograma y densidad del ecobici.
with(movilidad, hist(ecobici, freq = FALSE, breaks="Sturges", col="lightgreen",title='Histograma de 
      dendsidad de la afluencia en ecobici de CDMX'))
lines(density(movilidad$ecobici), col="green")

Series de tiempo.

Iniciemos un pequeño analisis de las respectivas series de estos datos:

Se puede notar la gran disminución significativa durante los ultimos días de marzo alcanzando los mayores mínimos alrededor de finales de abril e inicio de mayo.

Es importante señalar que en todas las series se presentan datos atípicos en las fechas:

  • 16 de septiembre de 2020
  • 2 de noviembre de 2020
  • 16 de noviembre de 2020
  • 25 de diciembre de 2020
  • 1 de enero de 2021

Estas fechas son considerados días festivos, y el hecho que es descenso sea más significativo se puede explicar por las medidas del Gobierno estos días, cerrando ciertas líneas y estaciones.

####### Serie de tiempo de metro
metro_p <-ggplot(movilidad)+geom_line(aes(x=fecha,y=metro), color="orange", size=0.5)+
  geom_point(aes(x=fecha,y=metro), size=0.5)+
  ggtitle("Serie de tiempo afluencia en el metro")+
  labs(x="Tiempo desde 24/marzo/2020 al 25/enero/2021", y="diferencia porcentual")+
  theme_bw()+theme(plot.title = element_text(hjust = 0.5))
ggplotly(metro_p)

Notamos que el comportamiento de las series de el metro como de metrobús son bastante parecidas, notando una disminución significativa en el mes de enero por el metro, debido a el problema de incendios presentados en estas fechas click.

####### Serie de tiempo de metrobus
metrobus_p<-ggplot(movilidad)+geom_line(aes(x=fecha,y=metrobus), color="red", size=0.5)+
  geom_point(aes(x=fecha,y=metrobus), size=0.5)+
  ggtitle("Serie de tiempo de afluencia en el metrobús")+
  labs(x="Tiempo desde 24/marzo/2020 al 25/enero/2021", y="diferencia porcentual")+
  theme_bw()+theme(plot.title = element_text(hjust = 0.5))
ggplotly(metrobus_p)

La serie de la afluencia en ecobici presenta un comportamiento más variable a lo largo del tiempo, presenta sus máximas disminuciones entre abril y julio, lo cual puede causar problemas al momento del ajuste.

####### Serie de tiempo de ecobici
ecobico_p<-ggplot(movilidad)+geom_line(aes(x=fecha,y=ecobici), color="green", size=0.5)+
  geom_point(aes(x=fecha,y=ecobici), size=0.5)+
  ggtitle("Serie de tiempo de afluencia en ecobici")+
  labs(x="Tiempo desde 24/marzo/2020 al 25/enero/2021", y="diferencia porcentual") +
  theme_bw()+theme(plot.title = element_text(hjust = 0.5))
ggplotly(ecobico_p)

Modelos y predicciones.

Es importante recordar que, al ajustar un modelo, los residuales de este deben comportarse como ruido blanco.

Metro

Para el metro, realizamos la serie de tiempo, y utilizamos la función auto.arima para ajustar el mejor modelo posible a los datos. Para comprobar que es un buen modelo, hacemos el test Ljung-Box, obteniendo un p_value = 0.9735, por lo cual los residuales se comportan como ruido blanco, por lo que el modelo puede ser usado para predecir.

ts_metro <- ts(movilidad$metro, start = c(2020, 3,24), 
               end = c(2021, 1, 25), frequency = 307)
metro_fit <- auto.arima(ts_metro)
summary(metro_fit)
  Series: ts_metro 
  ARIMA(1,1,4) 
  
  Coefficients:
           ar1      ma1     ma2     ma3     ma4
        0.9680  -1.3569  0.1680  0.1290  0.0889
  s.e.  0.0373   0.0687  0.0979  0.0935  0.0570
  
  sigma^2 estimated as 21.15:  log likelihood=-896.01
  AIC=1804.02   AICc=1804.3   BIC=1826.34
  
  Training set error measures:
                       ME     RMSE      MAE        MPE     MAPE MASE        ACF1
  Training set -0.1076176 4.553463 2.597945 -0.1865995 4.708741  NaN 0.001886462
Box.test(residuals(metro_fit), type = 'Ljung-Box')  ## p-value = 0.9735
  
    Box-Ljung test
  
  data:  residuals(metro_fit)
  X-squared = 0.0010997, df = 1, p-value = 0.9735
pronostico<-forecast(metro_fit,12,level=95)
plot(pronostico,main="Pronóstico para afluencia en el metro de CDMX.")

NOTA: Las predicciones con series de tiempo con fiables a corto plazo pero van convergiendo a la media al paso de los periodos, por lo que pierden eficacia. Por este motivo las predicciones se realizan para 12 días.

sliderInput(inputId='periodo', label ='Elija el periódo de predicción',
            min=1, max=35, value = 12)
renderPlot(plot(forecast(metro_fit,input$periodo,level=95),main="Pronóstico para afluencia en el metro de CDMX."))

Metrobús

El procedimiento es analógo, este modelo tampoco presento problemas para ajustar un buen modelo para predecir, ya que su p_value = 0.3256, por lo que no se rechaza que los residuales se comporten como ruido blanco, y presento los siguientes resultados:

ts_metrobus <- ts(movilidad$metrobus, start = c(2020, 3,24), 
               end = c(2021, 1, 25), frequency = 307)
metrobus_fit <- auto.arima(ts_metrobus)
summary(metrobus_fit)
  Series: ts_metrobus 
  ARIMA(3,1,2) 
  
  Coefficients:
           ar1      ar2      ar3      ma1     ma2
        0.9684  -0.6503  -0.2274  -1.3397  0.8824
  s.e.  0.0645   0.0731   0.0616   0.0372  0.0345
  
  sigma^2 estimated as 26.82:  log likelihood=-933.06
  AIC=1878.12   AICc=1878.4   BIC=1900.44
  
  Training set error measures:
                       ME    RMSE      MAE        MPE     MAPE MASE        ACF1
  Training set 0.09205957 5.12802 3.188772 -0.9871106 6.393434  NaN -0.05591643
Box.test(residuals(metrobus_fit), type = 'Ljung-Box')  ## p-value = 0.3256
  
    Box-Ljung test
  
  data:  residuals(metrobus_fit)
  X-squared = 0.96616, df = 1, p-value = 0.3256

Tratando de mejorar el modelo, se usan medias móviles de orden 3 para poder suavizar un poco la serie de tiempo, posteriormente se vuelve a ajustar el modelo, el cual arrojo un p-value = 0.8823, mucho mayor al modelo anterior, por lo que, estadísticamente los residuales se comportan como ruido blanco.

ts_metrobus_m <- ma(ts_metrobus, 3)
metrobus_arima <- auto.arima(ts_metrobus_m)
summary(metrobus_arima)
  Series: ts_metrobus_m 
  ARIMA(4,1,1) 
  
  Coefficients:
           ar1      ar2      ar3     ar4      ma1
        1.1827  -0.3855  -0.5040  0.4786  -0.7047
  s.e.  0.1085   0.0919   0.0811  0.0629   0.1083
  
  sigma^2 estimated as 3.893:  log likelihood=-634.24
  AIC=1280.47   AICc=1280.76   BIC=1302.76
  
  Training set error measures:
                       ME    RMSE      MAE         MPE     MAPE MASE       ACF1
  Training set 0.05131676 1.95361 1.296539 -0.02014026 2.598507  NaN -0.0084485
Box.test(residuals(metrobus_arima), type = 'Ljung-Box') ## ma = 3, p-value = 0.8823
  
    Box-Ljung test
  
  data:  residuals(metrobus_arima)
  X-squared = 0.021913, df = 1, p-value = 0.8823
pronostico<-forecast(metrobus_arima,12,level=95)
plot(pronostico,main="Pronóstico para afluencia en el metrobús de CDMX.")

De igual manera, se pueden apreciar las predicciones para este modelo, a doce días.

Ecobici.

El modelo inciar con el método auto.arima arrojo los siguientes resultados, cabe recordar que el comportamiento de esta serie era mucho más variables que las dos pasadas:

ts_ecobici <- ts(movilidad$ecobici, start = c(2020, 3,24), 
                  end = c(2021, 1, 25), frequency = 307)
ecobici_fit <- auto.arima(ts_ecobici)
summary(ecobici_fit)
  Series: ts_ecobici 
  ARIMA(2,1,2) 
  
  Coefficients:
           ar1      ar2      ma1     ma2
        1.0576  -0.7504  -1.5625  0.7947
  s.e.  0.0436   0.0450   0.0381  0.0360
  
  sigma^2 estimated as 54.89:  log likelihood=-1042.93
  AIC=2095.85   AICc=2096.05   BIC=2114.46
  
  Training set error measures:
                      ME     RMSE      MAE       MPE     MAPE MASE        ACF1
  Training set 0.1033292 7.347775 5.597451 -1.640404 9.565879  NaN -0.06304068
Box.test(residuals(ecobici_fit), type = 'Ljung-Box')  ## p-value = 0.2678
  
    Box-Ljung test
  
  data:  residuals(ecobici_fit)
  X-squared = 1.228, df = 1, p-value = 0.2678

Observamos que la función arrojo un modelo ARIMA(2,1,2), con 2 componentes autorregresivos, 2 medias móviles y una diferencia, sin embargo notamos que la prueba Box-Ljung arrojo un p_value = 0.2678, para ciertos níveles de significancia más altos podría no ser un gran modelo.

Al igual que el metodo anterior, usaremos medias móviles de orden 3 para suavizar la serie, obteniendo un modelo ARIMA(5,1,0) con un p-value en la prueba Ljung-Box igual a 0.5439, por lo que es un modelo estadísticamente mejor que es anterior y por lo tanto puede ser usado para hacer pronósticos.

ts_ecobici_m <- ma(ts_ecobici, 3)
ecobici_arima <- auto.arima(ts_ecobici_m)
summary(ecobici_arima)
  Series: ts_ecobici_m 
  ARIMA(5,1,0) 
  
  Coefficients:
           ar1      ar2      ar3      ar4      ar5
        0.1136  -0.3448  -0.4769  -0.2709  -0.3457
  s.e.  0.0545   0.0527   0.0487   0.0526   0.0548
  
  sigma^2 estimated as 6.192:  log likelihood=-705.32
  AIC=1422.63   AICc=1422.92   BIC=1444.92
  
  Training set error measures:
                       ME     RMSE      MAE         MPE     MAPE MASE       ACF1
  Training set 0.04659891 2.463763 1.919789 -0.03488921 2.979609  NaN 0.03463605
Box.test(residuals(ecobici_arima), type = 'Ljung-Box') ## ma = 2, p-value = 0.2999
  
    Box-Ljung test
  
  data:  residuals(ecobici_arima)
  X-squared = 0.36831, df = 1, p-value = 0.5439
                                                       ## ma = 3, p-value = 0.5439
pronostico<-forecast(ecobici_arima,12,level=95)
plot(pronostico,main="Pronóstico para afluencia en ecobici en CDMX.")

Movilidad en CDMX (Tránsporte particular).

Es interesante igualmente, estudiar el comportamiento de los automoviles particulares en la CDMX, ya que es una de las manera de movílidad más comunes, y por ende, podría ser el más itulizado durante el periodo de pandemia.

Análisis exploratorio.

La diferencias porcentuales con mayor frecuencia para el uso de autos partuculares ronda, mayormente, en descensos entre 40% y 60%, se presentaron también descensos de 80% en movilidad de vehículos, podría ser explicado por la medidas de Hoy no círcula, implementadas por el Gobierno ya que, este programa se extendío a todos los coches para finales de abril (Más información).

automoviles <- hospitalizados_transporte_movilidad[, c('fecha', 'transito')]
automoviles <- mutate(automoviles, fecha = as.Date(fecha, '%d/%m/%Y'))
with(automoviles, hist(transito, freq = FALSE, breaks="Sturges", col="gray"))
lines(density(automoviles$transito), col="black", lty=3, lwd=4)

Serie de tiempo.

Esta serie de tiempo ha presentado un comportamiento muy similar a las tres anteriores, presentando sus mayores descensos entre abril y julio, y teniendo una tendencia creciente a partir de este mes antes mencionado.

Los putno atípicos se presnetan en las mismas fechas que las series anteriores, es decir, en los días festivos.

Presenta también un gran descenso a finales de diciembre y principios de enero.

autos_p<-ggplot(automoviles)+geom_line(aes(x=fecha,y=transito), color="purple", size=0.5)+
  geom_point(aes(x=fecha,y=transito), size=0.5)+
  ggtitle("Series de tiempo de afluencia en transportes particulares.")+
  labs(x="Tiempo desde 24/marzo/2020 al 25/enero/2021", y="automovil") +
  theme_bw()+theme(plot.title = element_text(hjust = 0.5))
ggplotly(autos_p)

Modelos y predicciones.

El ajuste de esta serie de tiempo dio los siguientes resultados:

  • El mejor modelo ajustado es un ARIMA(5,1,2), con 5 componenetes autorregresivos, una diferencia y dos componenetes de medias móviles.
  • EL p_value de la prueba Box-Ljung dio 0.9489, por lo que los residuales presentan un comportamiento de ruido blanco, y se puede decir que es un buen modelo, por lo que se puede utilizar para predicciones.
ts_autos <- ts(automoviles$transito, start = c(2020, 3,24), 
                 end = c(2021, 1, 25), frequency = 307)
autos_fit <- auto.arima(ts_autos)
summary(autos_fit)
  Series: ts_autos 
  ARIMA(5,1,2) 
  
  Coefficients:
           ar1      ar2      ar3      ar4      ar5      ma1     ma2
        0.5872  -0.5691  -0.2482  -0.1921  -0.1612  -1.2027  0.7801
  s.e.  0.1107   0.0716   0.0758   0.0668   0.0762   0.0984  0.0657
  
  sigma^2 estimated as 69.69:  log likelihood=-1077.27
  AIC=2170.54   AICc=2171.02   BIC=2200.3
  
  Training set error measures:
                      ME     RMSE      MAE       MPE     MAPE MASE         ACF1
  Training set 0.1226657 8.237961 5.630008 -2.243657 10.71757  NaN -0.003647203
Box.test(residuals(autos_fit), type = 'Ljung-Box')  ## p-value = 0.9489
  
    Box-Ljung test
  
  data:  residuals(autos_fit)
  X-squared = 0.0041105, df = 1, p-value = 0.9489
pronostico<-forecast(autos_fit,12,level=95)
plot(pronostico,main="Pronóstico para afluencia de vehículos particulares en CDMX")

Tráfico en servicios de Internet.

De todos los proveedores, seleccionaremos a los 3 que mas datos generan de manera local asi como 1 de los que menos generan.

  #Grafica de area.
  ggplot(datos_internet, aes(x = Fecha, y = Trafico_Datos_Local)) +
  geom_area(aes(color = Proveedor, fill = Proveedor),
  alpha = 0.5, position=position_dodge(0.8)) +
  ggtitle("Trafico de datos durante la pandemia") +
  xlab("Mes 2020") +
  ylab("Datos en GB") +
  theme_minimal() +
  scale_color_manual(values=c("#00AFBB", "#E7B800", "#CC0000", "#006600", 
                              "#669999", "#00CCCC", "#660099", "#FC0066", 
                              "#AF9999", "#FE99FF", "#559955", "#A990CC", 
                              "#660099", "#CC0066")) +
  scale_fill_manual(values=c( "#00AFBB", "#E7B800", "#CC0000", "#006600", 
                              "#669999", "#00CCCC", "#660099", "#FC0066", 
                              "#AF9999", "#FE99FF", "#559955", "#A990CC", 
                              "#660099", "#CC0066"))

En este caso fueron seleccionados: Movistar, Unefon, Clarovideo y DirecTV.

Series de tiempo.

Vayamos a realizar un analisis ganeral de las series de tiempo que nos proporcionan los proveeedores de servicios. Tras observar cada una de las series, se puede llegar a un punto en comun, todas tienen puntos de inflexion cerca de los meses de Julio, Agosto y Enero, ya que estos son los meses de transicion de vacaciones a clases/trabajo o viceversa por parte de estudiantes o trabajadores; Por motivos de la pandemia, el regreso a labores se debe de realizar de manera puramente virtual y en algunos escasos casos de manera semipresencial. ¿A que va esto?, pues a que todo mundo ahorita depende de servicios de internet o de entretenimiento ya que por decreto oficial, nadie deberia de salir de su casa.

NOTA. Los datos atipicos de las graficas fueron “Normalizados”, sustituyendo el dato por el promedio del dato de un dia anterior con el de un dia posterior, esto con el fin de brindar un buen modelo de prediccion.

grafica_movi <- ggplot(movistar) +
  geom_line(aes(x=Fecha, y= Trafico_Datos_Local), color="green", size=0.8) +
  geom_point(aes(x=Fecha, y= Trafico_Datos_Local), size=1) +
  ggtitle("Movistar") +
  labs(x="Tiempo", y="Datos (GB)") +
  theme_bw() +
  theme(plot.title = element_text(hjust = 0.5))
ggplotly(grafica_movi)

Antes que nada, se debe aclarar que la compañia “Movistar” es una empresa de servicios telefonia movil, cuyo proposito es comunicar a los cientos de miles de mexicanos con el mundo exterior y de manera local. En esta grafica se puede observar el alce de la demanda de servicios telefonicos justo cuando empezo el periodo vacacional y una caida una vez se regreso a dias laborales.

grafica_une <- ggplot(une) +
  geom_line(aes(x=Fecha, y= Trafico_Datos_Local), color="yellow", size=0.8) +
  geom_point(aes(x=Fecha, y= Trafico_Datos_Local), size=1) +
  ggtitle("Unefon") +
  labs(x="Tiempo", y="Datos (GB)") +
  theme_bw() +
  theme(plot.title = element_text(hjust = 0.5))
ggplotly(grafica_une)

Como dato previo al analisis, se debe aclarar que la compañia “Unefon” es una empresa de servicios telefonia movil, cuyo proposito es comunicar a los cientos de miles de mexicanos con el mundo exterior y de manera local. En esta grafica se puede observar la misma demanda que tuvo movistar, pero con una mayor cantidad de usuarios asociados a esta telefonia al principio, tambien demuestra el alce de la demanda de servicios telefonicos justo cuando empezo el periodo vacacional y una caida una vez se regreso a dias laborales.

grafica_claro <- ggplot(claro) +
  geom_line(aes(x=Fecha, y= Trafico_Datos_Local), color="red", size=0.8) +
  geom_point(aes(x=Fecha, y= Trafico_Datos_Local), size=1) +
  ggtitle("Claro") +
  labs(x="Tiempo", y="Datos (GB)") +
  theme_bw() +
  theme(plot.title = element_text(hjust = 0.5))
ggplotly(grafica_claro)

Como dato previo, se debe aclarar que la compañia “Claro” es una empresa de servicios internet y telefonia fija, asi como servicios de entretenimiento en linea, cuyo proposito es de brindar un servicio total a sus clientes. En esta grafica se puede observar un cambio significativo con respecto a las empresas anteriores, como esta es una empresa mas orientado a lo “fijo” y al entretenimiento, por motivos de confinamiento agarro mas fuerza y tuvo un incremento desde el inicio de la pandemia; como las personas se la pasan en su hogar, necesitan una forma de pasar el tiempo y que mejor con los servicios de entretenimiento qye ofrece esta empresa y ademas, si estas en casa, no hay necesidad de tener un plan movil de internet si ya tienes internet fijo.

grafica_directv <- ggplot(directv) +
  geom_line(aes(x=Fecha, y= Trafico_Datos_Local), color="blue", size=0.8) +
  geom_point(aes(x=Fecha, y= Trafico_Datos_Local), size=1) +
  ggtitle("Directv") +
  labs(x="Tiempo", y="Datos (GB)") +
  theme_bw() +
  theme(plot.title = element_text(hjust = 0.5))
ggplotly(grafica_directv)

Como dato previo, se debe aclarar que la compañia “Directv” es una empresa de servicios de television por cable, cuyo proposito es de brindar canales exclusivos que no se pueden obtener a traves de television abierta a sus clientes. En esta grafica se puede observar un cambio significativo con respecto a las empresas anteriores, y un comportamiento casi contrario con respecto a Claro, ya que esta tambien provee servicio de entretenimiento, pero ¿Porque?. Muy facil!, el internet agarro gran fuerza, reemplazando asi la television abierta y por cable desde el momento en que salio y empresas exclusivas de entretenimiento que solo pueden ser visitados a traves de internet y de popularidad masiva, aprovecharon la pandemia para lanzar una gran cantidad de espectaculos, logrando asi que muchas personas que tenian television por cable, cancelaran el servicio porque en internet podian encontrar mas variedad y hasta los mismos programas por un precio mas barato o inclusive gratis!

Como breve conclusion de las graficas anteriores, Ante el confinamiento, los servicios de telefonía e internet fijos así como la TV de paga fueron los servicios que tomaron mayor fuerza al elevar sus ingresos y captar más clientes.

Modelos y Predicciones.

Es importante recordar que, al ajustar un modelo, los residuales de este deben comportarse como ruido blanco.

Para las empresas a analizar (Movistar, Claro, Unefon y DirecTV), se realizaron series de tiempo, asi como uso de la la función auto.arima para ajustar el mejor modelo posible a los datos. Para comprobar son buenos modelos, se hizo el test Ljung-Box.

Movistar.

  ts_movistar = ts(movistar$Trafico_Datos_Local, start = c(2020,3,30),
                      end = c(2021,1,26), frequency = 305)
  modelo_arima_movistar <- auto.arima(ts_movistar)
  summary(modelo_arima_movistar)
  Series: ts_movistar 
  ARIMA(2,1,2) 
  
  Coefficients:
           ar1      ar2      ma1     ma2
        1.2261  -0.9438  -1.3585  0.8792
  s.e.  0.0318   0.0376   0.0285  0.0521
  
  sigma^2 estimated as 495865982:  log likelihood=-3462.44
  AIC=6934.88   AICc=6935.09   BIC=6953.45
  
  Training set error measures:
                     ME     RMSE      MAE         MPE     MAPE MASE       ACF1
  Training set 218.0964 22084.16 17076.06 -0.07347595 3.377077  NaN -0.2521025

Test Ljung-Box:

  #Ver si es un buen modelo.
  Box.test(residuals(modelo_arima_movistar), type = 'Ljung-Box')
  
    Box-Ljung test
  
  data:  residuals(modelo_arima_movistar)
  X-squared = 19.512, df = 1, p-value = 9.996e-06

Se puede observar que el ajuste arrojo un modelo ARIMA (2,1,2), con 2 componentes autorregresivos, 2 medias móviles y una diferencia, Sin embargo notamos que la prueba Ljung-Box obtuvo un p_value = 9.996e-06, lo cual nos indica por contraste de hipotesis que los residuales no se comportan como ruido blanco; por lo que el modelo no puede ser usado para predecir.

Para obtener un modelo que nos sirva para predicciones y para corregir la media de los residuales, usaremos medias móviles de orden 2 para suavizar la serie; ya evaluada la serie de tiempo, se logro obtener los siguientes resultados:

  ts_movistar = ts(movistar$Trafico_Datos_Local, start = c(2020,3,30),
                      end = c(2021,1,26), frequency = 305)
  #Suavizamos el modelo para obtener una mejor prediccion.
  ma_ts_movistar <- ma(ts_movistar,2)
  modelo_arima_movistar <- auto.arima(ma_ts_movistar)
  summary(modelo_arima_movistar)
  Series: ma_ts_movistar 
  ARIMA(2,1,0) with drift 
  
  Coefficients:
           ar1      ar2     drift
        0.8830  -0.7363  327.0304
  s.e.  0.0397   0.0396  592.8968
  
  sigma^2 estimated as 77445501:  log likelihood=-3160.37
  AIC=6328.74   AICc=6328.87   BIC=6343.56
  
  Training set error measures:
                     ME     RMSE      MAE       MPE     MAPE MASE       ACF1
  Training set 12.95543 8741.838 7193.542 0.0220436 1.433119  NaN 0.02727393

Test Ljung-Box para el modelo suavizado:

  #Ver si es un buen modelo.
  Box.test(residuals(modelo_arima_movistar), type = 'Ljung-Box')
  
    Box-Ljung test
  
  data:  residuals(modelo_arima_movistar)
  X-squared = 0.22689, df = 1, p-value = 0.6338

Tras realizar estas modificaciones, el nuevo ajuste nos arrojo un modelo ARIMA(2,1,0) con 2 componentes autorregresivos, 0 medias móviles y una diferencia. Ahora tras realizar la prueba Ljung-Box se obtuvo un p_value = 0.6338, lo cual nos indica que los residuales se comportan como ruido blanco y es un modelo que se puede usar para realizar pronosticos.

Tras haber ajustado el modelo, se pudo obtener el siguiente pronostico:

  #Ver si es un buen modelo.
  prediccion_movistar <- forecast(modelo_arima_movistar,10,level=95)
  plot(prediccion_movistar, main="Pronostico para Movistar.")

Claro.

  ts_claro = ts(claro$Trafico_Datos_Local, start = c(2020,3,30),
              end = c(2021,1,26), frequency=305)
  modelo_arima_claro <- auto.arima(ts_claro)
  summary(modelo_arima_claro)
  Series: ts_claro 
  ARIMA(3,1,2) 
  
  Coefficients:
           ar1      ar2      ar3      ma1     ma2
        0.8657  -0.5184  -0.3363  -1.3552  0.7906
  s.e.  0.0610   0.0719   0.0620   0.0375  0.0690
  
  sigma^2 estimated as 3.283e+09:  log likelihood=-3748.74
  AIC=7509.48   AICc=7509.76   BIC=7531.76
  
  Training set error measures:
                     ME     RMSE      MAE         MPE     MAPE MASE        ACF1
  Training set 1332.516 56730.32 46538.55 -0.09503242 4.399208  NaN -0.09772703

Test Ljung-Box:

  #Ver si es un buen modelo.
  Box.test(residuals(modelo_arima_claro), type = 'Ljung-Box')
  
    Box-Ljung test
  
  data:  residuals(modelo_arima_claro)
  X-squared = 2.9321, df = 1, p-value = 0.08683

Se puede observar que el ajuste arrojo un modelo ARIMA (3,1,2), con 3 componentes autorregresivos, 2 medias móviles y una diferencia, Sin embargo notamos que la prueba Ljung-Box obtuvo un p_value = 0.0868, lo cual nos indica que los residuales se comportan como ruido blanco. El problemas es que; para muchos níveles de significancia podría no ser un gran modelo.

Para obtener un modelo que nos sirva para predicciones y para corregir la media de los residuales, agregamos otra diferencia al modelo ARIMA; en base a esto, se logro obtener los siguientes resultados:

  ts_claro = ts(claro$Trafico_Datos_Local, start = c(2020,3,30),
              end = c(2021,1,26), frequency=305)
  modelo_arima_claro <- Arima(ts_claro, order = c(3,2,2))
  summary(modelo_arima_claro)
  Series: ts_claro 
  ARIMA(3,2,2) 
  
  Coefficients:
           ar1      ar2      ar3      ma1     ma2
        0.4597  -0.2298  -0.3165  -1.8154  0.8304
  s.e.  0.0623   0.0602   0.0597   0.0371  0.0367
  
  sigma^2 estimated as 4.065e+09:  log likelihood=-3770.64
  AIC=7553.28   AICc=7553.57   BIC=7575.54
  
  Training set error measures:
                      ME    RMSE      MAE        MPE     MAPE MASE        ACF1
  Training set -32.53311 63016.1 50555.39 -0.2353234 4.757215  NaN -0.08174628

Test Ljung-Box para el modelo ajustado:

  #Ver si es un buen modelo.
  Box.test(residuals(modelo_arima_claro), type = 'Ljung-Box')
  
    Box-Ljung test
  
  data:  residuals(modelo_arima_claro)
  X-squared = 2.0516, df = 1, p-value = 0.152

Tras realizar estas modificaciones, el nuevo ajuste nos arrojo un modelo ARIMA(3,2,2) con 2 componentes autorregresivos, 2 medias móviles y 2 diferencias. Ahora tras realizar la prueba Ljung-Box se obtuvo un p_value = 0.152, lo cual nos indica que los residuales se comportan como ruido blanco y es un modelo mejor que al anterior, pero indica que; para ciertos níveles de significancia más altos podría no ser un gran modelo.

Tras haber ajustado el modelo, se pudo obtener el siguiente pronostico:

  #Ver si es un buen modelo.
  prediccion_claro <- forecast(modelo_arima_claro,10,level=95)
  plot(prediccion_claro, main="Pronostico para Claro")

Unefon.

  ts_unefon = ts(une$Trafico_Datos_Local,start = c(2020,3,30),
                     end = c(2021,1,26), frequency=305)
  modelo_arima_unefon <- auto.arima(ts_unefon)
  summary(modelo_arima_unefon)
  Series: ts_unefon 
  ARIMA(4,1,2) 
  
  Coefficients:
          ar1      ar2      ar3      ar4      ma1     ma2
        0.651  -0.5627  -0.1949  -0.2961  -1.1882  0.7989
  s.e.  0.070   0.0715   0.0673   0.0621   0.0462  0.0603
  
  sigma^2 estimated as 1.412e+09:  log likelihood=-3620.2
  AIC=7254.4   AICc=7254.78   BIC=7280.4
  
  Training set error measures:
                     ME     RMSE      MAE        MPE     MAPE MASE        ACF1
  Training set 104.3386 37145.56 28972.25 -0.1464995 3.562211  NaN -0.02945804

Test Ljung-Box:

  #Ver si es un buen modelo.
  Box.test(residuals(modelo_arima_unefon), type = 'Ljung-Box')
  
    Box-Ljung test
  
  data:  residuals(modelo_arima_unefon)
  X-squared = 0.26642, df = 1, p-value = 0.6057

Se puede observar que el ajuste arrojo un modelo ARIMA (4,1,2), con 4 componentes autorregresivos, 2 medias móviles y una diferencia, Sin embargo notamos que la prueba Ljung-Box obtuvo un p_value = 0.6057, lo cual nos indica que los residuales se comportan como ruido blanco y es un buen modelo para generar predicciones.

Tras el ajuste del modelo, se pudo obtener el siguiente pronostico:

  #Ver si es un buen modelo.
  prediccion_unefon <- forecast(modelo_arima_unefon, 12, level=95)
  plot(prediccion_unefon, main="Pronostico para Unefon")

DirecTV.

  ts_directv = ts(directv$Trafico_Datos_Local, start = c(2020,3,30),
                end = c(2021,1,26), frequency=305)
  modelo_arima_directv <- auto.arima(ts_directv, seasonal=TRUE)
  summary(modelo_arima_directv)
  Series: ts_directv 
  ARIMA(2,1,2) with drift 
  
  Coefficients:
           ar1     ar2      ma1     ma2    drift
        1.1069  -0.663  -1.3949  0.5808  -8.5755
  s.e.  0.0692   0.064   0.0727  0.0709  35.1089
  
  sigma^2 estimated as 3362602:  log likelihood=-2704.81
  AIC=5421.62   AICc=5421.9   BIC=5443.9
  
  Training set error measures:
                     ME     RMSE     MAE        MPE     MAPE MASE        ACF1
  Training set 11.12746 1815.554 1440.87 -0.0728653 2.683842  NaN -0.07059401

Test Ljung-Box:

  #Ver si es un buen modelo.
  Box.test(residuals(modelo_arima_directv), type = 'Ljung-Box')
  
    Box-Ljung test
  
  data:  residuals(modelo_arima_directv)
  X-squared = 1.53, df = 1, p-value = 0.2161

Se puede observar que el ajuste arrojo un modelo ARIMA (2,1,2), con 2 componentes autorregresivos, 2 medias móviles y una diferencia, Sin embargo notamos que la prueba Ljung-Box obtuvo un p_value = 0.2161, lo cual nos indica que los residuales se comportan como ruido blanco; pero indica que; para ciertos níveles de significancia más altos podría no ser un gran modelo.

Tras el ajuste del modelo, se pudo obtener el siguiente pronostico:

  #Ver si es un buen modelo.
  prediccion_directv <- forecast(modelo_arima_directv, 12, level=95)
  plot(prediccion_directv, main="Pronostico para Directv")

Precio del dólar.

A lo largo de los 286 días registrados observamos un promedio de 22.08 y 22.04 de apertura y cierre respectivamente. El segundo cuartil (la mediana) se encuentra entre 22.14 y 22.10.

El máximo (max) y el mínimo (min) son los picos y los valles que tuvo el valor a lo largo del día. A lo largo de los 286 días registrados observamos un promedio de 22.28 y 22.87 de máximo y mínimo respectivamente. El segundo cuartil (la mediana) se encuentra entre 22.25 y 21.93.

summary( select(datosmut, Apertura, Cierre, max, min))
      Apertura         Cierre           max             min       
   Min.   :19.77   Min.   :19.77   Min.   :19.90   Min.   :19.69  
   1st Qu.:21.12   1st Qu.:21.12   1st Qu.:21.30   1st Qu.:21.00  
   Median :22.14   Median :22.10   Median :22.25   Median :21.93  
   Mean   :22.08   Mean   :22.04   Mean   :22.28   Mean   :21.87  
   3rd Qu.:22.76   3rd Qu.:22.74   3rd Qu.:22.95   3rd Qu.:22.62  
   Max.   :25.36   Max.   :25.34   Max.   :25.76   Max.   :24.67

En el gráfico podemos apreciar que es una serie No estacionaria pues su distribución y sus parámetros varian a lo largo de la serie de tiempo, en otras palabras:

-La media no es constante pues decrementa a lo largo del tiempo -Su varianza tampoco es una constante.

Cabe recalcar que, por lo general, en los indicadores de activos financieros no se encuentran datos estacionales.

Dada la volatilidad que presenta la serie, se suaviza por medio de el uso de medias móviles de orden 3, con el fin de tene una serie más sencilla de ajustar.

Con esta serie suavizada se puede ajustar el mejor modelo posible a los datos, obteniendo un modelo ARIMA(3,1,1), con 3 componentes autorregresivos, una diferencia a los datos y un componente autorregresivo.

Este modelo produjo un p-value = 0.893, en la prueba Ljung-Box, por lo que los residuales, estadísticamente, se comportan como ruido blanco, por lo que el modelo puede ser usado para obtener pronósticos a corto plazo con un buen nivel de confianza.

prueba1 <- auto.arima(serie1)
summary(prueba1)
  Series: serie1 
  ARIMA(3,1,1) with drift 
  
  Coefficients:
           ar1     ar2      ar3     ma1    drift
        0.3560  0.2480  -0.4459  0.4426  -0.0218
  s.e.  0.1115  0.0959   0.0718  0.1074   0.0126
  
  sigma^2 estimated as 0.01122:  log likelihood=168.81
  AIC=-325.63   AICc=-325.2   BIC=-305.78
  
  Training set error measures:
                        ME      RMSE       MAE          MPE      MAPE MASE
  Training set -0.00114181 0.1043634 0.0752166 -0.003481622 0.3363488  NaN
                      ACF1
  Training set 0.009374614
Box.test(residuals(prueba1), type = 'Ljung-Box') 
  
    Box-Ljung test
  
  data:  residuals(prueba1)
  X-squared = 0.018105, df = 1, p-value = 0.893
pronos <- forecast(prueba1,12,level=95)

El modelo ajustado otorgo estos pronósticos del precio de cierre del dólar:

pronos_dolar <- forecast(prueba1,12,level=95)
plot(pronos_dolar, main="Pronostico para el precio del dólar. ")

Conclusiones.

Respecto a la movilidad:

  1. Los modelos ajustados a la serie de tiempo referente al metro de la ciudad de México, pronoótico que las diferencia porcentuales, al estas fechas (principios de febrero), rondarán alrededor del 74% al 75% de reducción de afluencia respecto a un día típico.

  2. Los datos registrados del uso de metrobús pronósticaron que la afluencia en este medio de transporte podría registrar un descenso respecto a un día típico de valores entre 32.9% y 35%.

  3. La serie de tiempo respecto al uso de la ecobici, al ser la que presentabá mayor variabilidad produjó que los pronóstivcos también presentarán mucha variabilidad, prediciendo descensos en la afluencia en este medio de transporte que varían entre 49% hasta pronósticos de 65%.

  4. La serie de tiempo acerca de el uso de autómoviles particulares fue de las series que presentó mejor p-value en la prueba Ljung-Box, y los pronósticos del modelo resultando arrojan descensos en la afluencia desde un 48% hasta un 52.5% respecto a un día típico.

Cabe resaltar que los valores predichos son un pronótico respecto a un modelo matemático y pueden presentar variación respecto a días atípicos que se puedan presentar en el periodo de predicción.

Respecto al uso de datos:

  1. El modelos ajustado para el uso de GB de la telefonía Movistar presentó pronósticos de uso de entre 515 mil y 558 mil GB diarios, mientras que los intervalos de confianza presentaron valores por encima de los 464 GB hasta un posible máximo de 620 GB diarios.

  2. Recordemos que uno de los modelos más complejos de ajustar fue el relacionado con el uso de servicios de Marca Claro, para esta prestadora de servicios en línea se predijeron valores de uso de entre 1.15 millones de GB hasta un valor calculado de 1.29 millones de GB diarios.

  3. Respecto a la compañía telefónica Unefon, el modelo ajustado arrojo un consumo de GB que podría rondar entre 885 mil GB diarios hasta un posible valor pronósticado máximo de 951 mil GB diarios, comparando las dos telefonías, es la que presenta un mayor uso de GB, y lo pronósticos tambíen consideraron esa tendencia.

  4. Para directTV, la prestadora de servicio de televisión de paga, el modelo ajustado pronóstico que el uso de GB de los usuarios al día podrían rondar entre 51.8k Gb diarios hasta un posible máximo de 54.2k GB diarios.

Con esta predicciones se puede notar que, en periodo de pandemia, los usuarios prefieren utilizar servicios de telecomunicación que usar servicios de televisión por cable.

Respecto al precio del dólar.

La tendencia del precio del dólar se veía a la baja desde las series de tiempo, mientras que el modelo ajustado pronóstico que el precio podría oscilar entre 19.5 hasta 19.7 pesos, esto con intervalos de confianza deposibles mínimos entre 18.2 hasta posibles máximos de 20.87 pesos; esto para los precios de cierre. Si bien es verdad que esta variable es extremadamente sencible a los cambios y sucesos de diversos sectores, las predicciones oscilan entre intervalos muy pequeños.

Notas importantes.

Para interactuar de mejor manera con los datos y resultados hemos desarollado una pequeña aplicación, la cual puede tener acceso mediante el siguiente link.